library(ggplot2)
library(reshape2)
library(magrittr)
library(dplyr)
library(ggrepel)
library(cowplot)
library(gapminder)
bliga <- read.csv("http://www.football-data.co.uk/mmz4281/1516/D1.csv") %>% #CSV einlesen
select(Date:FTR) %>% #nur benätigte Spalten auswählen
plyr::rename(c("HomeTeam" = "H", "AwayTeam" = "A")) %>% #Umbenennen der Spalten für späteren Vergleich
mutate(matchday = rep(1:34, each=9)) %>% #Hinzufügen des Spieltags
melt(measure.vars = c("H","A"), variable.name = "Place", value.name = "Team") #Tabelle in long Format umwandeln
Die Tabelle wird ins long Format umgewandelt, sodass in jeder Zeile nur ein Team vorhanden ist.
levels(bliga$Place) <- c("H", "A", "D") #hinzufügen des "D" levels
bliga$Points <- 0 #alle Punkte auf 0 setzen
bliga$Points[bliga$FTR=="D"]<-1 #bei Unentschieden 1 Punkt
bliga$Points[bliga$FTR==bliga$Place]<-3 #Bei Übereinstimmung von FTR und Place, gab es einen Sieg. -> 3 Punkte
bliga <- bliga %>%
arrange(matchday) %>% #sortieren nach Spieltag
group_by(Team) %>% #Teams gruppieren
mutate(totalPts = cumsum(Points)) #errechnen der kumulierten Summe für jede Mannschaft an jedem Spieltag
Für jede Mannschaft wird pro Spieltag der Wert des vorigen Spieltags zu den an diesem Spieltag erzielten Punkten addiert.
teamAbbr <- data.frame(Team = c("Augsburg", "Bayern Munich", "Darmstadt", "Dortmund",
"Ein Frankfurt", "FC Koln","Hamburg", "Hannover",
"Hertha", "Hoffenheim", "Ingolstadt", "Leverkusen",
"M'gladbach", "Mainz", "Schalke 04", "Stuttgart",
"Werder Bremen", "Wolfsburg"),
Abbr = c("FCA", "FCB", "SV98", "BVB", "SGE", "KOE", "HSV",
"H96", "BSC", "TSG", "FCI", "LEV", "BMG", "M05",
"S04", "VFB", "BRE", "VFL"),
teamColor = c("red", "red", "blue", "goldenrod1", "red", "red",
"blue", "forestgreen", "blue", "blue", "black", "red",
"forestgreen", "red","blue", "red", "forestgreen", "forestgreen"))
bliga <- merge(bliga, teamAbbr) #Kombiniere bliga Tabelle mit teamAbbr Tabelle
Tabelle mit Abkürzungen und Teamfarbe für jedes Team, die dann mit der vorigen Tabelle vereint wird.
g <- ggplot(bliga, aes(x=matchday, y=totalPts, group=Team, fill=Abbr, col=Team)) + #Plot
geom_line(aes(color=Team), size=.8, alpha=.7) + #Zeichne Linien
scale_x_continuous(breaks=pretty(bliga$matchday, n=max(bliga$matchday)),
expand = c(0, 0)) + #Verändern der x-Achsen-Skalendarstellung
scale_y_continuous(breaks=pretty(bliga$totalPts, n=max(bliga$totalPts)),
expand = c(0, 0)) + #Verändern der y-Achsen-Skalendarstellung
coord_cartesian(xlim = c(min(bliga$matchday), max(bliga$matchday) + 1.6),
ylim = c(min(bliga$totalPts),
max(bliga$totalPts) + .8)) + #Platz am rechten Rand schaffen für Teamnamen
geom_text_repel(data = filter(bliga, matchday == max(matchday)),
aes(label=Abbr), size = 3, nudge_x = .8) + #Teamnamen ans ende der Linie schreiben
labs(x = "match day", y = "points") + #Beschriftung der Achsen
scale_color_manual(values=as.vector(teamAbbr$teamColor)) #Linien in Teamfarben darstellen
ggdraw(switch_axis_position(g + theme_light() + theme(legend.position = "none") , axis = 'y')) +
theme(legend.position = "none") #Y-Achsen-Werte auf rechte Seite der Tabell verschieben
ecoDat = read.csv(file=file.path("data", "EconomistData.csv"))
rsquared = summary(lm(log(CPI)~HDI, data=ecoDat))$r.squared #R^2 berechnen
rsquared
## [1] 0.5359422
rsquared = round(rsquared*100, 0) #Runden des Wertes
rsquared
## [1] 54
rsqstr = as.expression(bquote("R"^"2" * "= " * .(rsquared) * "%")) #String mit R^2 Wert generieren
ggplot(ecoDat, aes(x=CPI, y=HDI, color=variable)) +
geom_line(aes(fill="regline"),stat="smooth", position = "identity", color = "red", se=FALSE,
method = "lm", formula = y ~ log(x), size = 1, alpha=.6, show.legend = TRUE) + #Regressionslinie
geom_point(shape=21, stroke=1, size=2.5, fill="white", aes(color=Region), alpha=.9) + #Datenpunkte
scale_x_continuous(breaks=c(1:10), limits=c(1,10)) + #Verändern der x-Achsen-Skalendarstellung
scale_y_continuous(breaks=seq(0,1,0.1), limits = c(0.2, 1.0)) + #Verändern der y-Achsen-Skalendarstellung
ggtitle("Corruption and human development") + #Titel
labs(x = "Corruption Perceptions Index, 2011 (10=least corrupt)", y = "Human Development Index, 2011 (1=best)")+ #Beschriftung der Achsen
geom_text_repel(data = filter(ecoDat, Country %in% c("Afghanistan", "Greece", "China", "India",
"Rwanda", "Spain", "France", "United States",
"Japan", "Norway", "Singapore")),
aes(label=Country),color="black", size = 3, force=2, box.padding = unit(0.65, 'lines')) + #Beschriftungen der Datenpunkte
guides(col=guide_legend(nrow=1, override.aes = list(linetype = 0), order=2)) + #Anpassung der Legende
scale_color_manual(values = c("EU W. Europe"="#134B62",
"Americas"="#24A7DA",
"Asia Pacific"="#85D7F6",
"East EU Cemt Asia" = "#248E83",
"MENA"="#F15545",
"SSA"="#873829"), #Farben definieren
breaks = c("EU W. Europe","Americas","Asia Pacific","East EU Cemt Asia"
,"MENA","SSA"), #Reihenfolge definieren
labels = c("OECD", "Americas","Asia &\nOceania","Central &\nEastern Europe",
"Middle East &\nnorth Africa","Sub-Saharan\nAfrica") #Namen ändern
)+
scale_fill_manual(labels = rsqstr, values = NA)+ #R^2 Wert in Legende
theme_light() + #Theme anwenden
theme(axis.title=element_text(size = 10, face="italic"),
plot.title=element_text(size = 12, face="bold", hjust = 0),
axis.ticks = element_blank(),
legend.position="top",
legend.title=element_blank(),
legend.direction="horizontal",
legend.box="horizontal",
legend.box.just = "left",
legend.key = element_blank(),
legend.text.align = 0,
legend.key.width = unit(.5, "cm"),
legend.key.height = unit(.1, "cm"),
legend.background=element_blank()
)
#gap<-data.frame(gapminder,color = I(continent_colors[match(gapminder$continent,names(continent_colors))]))
gap<-gapminder
gapa<-filter(gap,year==1997)#Nur 1997
ggplot(gapa,aes(x=gdpPercap,y=lifeExp,group=continent))+
geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
scale_x_log10(breaks=c(400,4000,40000))+
scale_y_continuous(breaks=c(25,50,75))+
labs(y="lifespan",x="income")+
ggtitle("Lifespan and income in 1997")
b)Die “Daumenkino”-Version des im BBC-Video gezeigten zeitlichen Verlaufes von 1952-2007:
ggplot(gap,aes(x=gdpPercap,y=lifeExp,group=continent))+
geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
scale_x_log10(breaks=c(400,4000,40000))+
scale_y_continuous(breaks=c(25,50,75))+
labs(y="lifespan",x="income")+
facet_wrap(~year)+
ggtitle("Lifespanand income over time (1952-1997)")
Hier wird dargestellt, wie sich die einzelnen Länder innerhalb der Regionen betreffend Lebenserwartung und BIP/Kopf zunächst 1952 und dann 2007 positionieren.
ggplot(filter(gap,year==1957),aes(x=gdpPercap,y=lifeExp,group=continent))+
geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
scale_x_log10(breaks=c(400,4000,40000))+
scale_y_continuous(breaks=c(25,50,75))+
labs(y="lifespan",x="income")+
facet_wrap(~continent)+
ggtitle("Lifespan and income in 1957")
ggplot(filter(gap,year==2007),aes(x=gdpPercap,y=lifeExp,group=continent))+
geom_point(aes(size=pop,color=continent,stroke=1),alpha=0.5)+
scale_x_log10(breaks=c(400,4000,40000))+
scale_y_continuous(breaks=c(25,50,75))+
labs(y="lifespan",x="income")+
facet_wrap(~continent)+
ggtitle("Lifespan and income in 2007")
c)Hier wird versucht zunächst das Einkommen und dann die Lebenserwartung über die Zeit für alle Länder in einem Diagramm darzustellen. An dieser Grafik kann man erkennen, dass Afrika sowohl im Einkommen, als auch in der Lebenserwartung zwar deutlich zugelegt hat, allerdings im Vergleich zu den restlichen Kontinenten zurückliegt:
ggplot(gap,aes(x=year,y=gdpPercap,group=country,color=continent))+
scale_y_log10(breaks=c(400,4000,40000))+
geom_path(aes(alpha=0.1,size=2))+
labs(y="income")+
ggtitle("Income of 142 countries over time (1952-2007)")
ggplot(gap,aes(x=year,y=lifeExp,group=country,color=continent,size=2))+
geom_path(aes(alpha=0.3))+
labs(y="lifespan")+
ggtitle("Lifespan of 142 countries over time (1952-2007)")
Da diese Übersicht die Möglichkeiten von geom_path nicht voll nutzt, sowohl Lebenserwartung als auch Einkommen darzustellen, haben wir zudem einen Graphen für nur ein Land (bezüglich der Fragestellung fahren wir uns nicht sicher, was gefragt ist) erstellt. Deutschland weißt einen Zuwachs sowohl in der Lebenserwartung, als auch im Einkommen auf und entpsricht somit der Aussage von BBC.
ggplot(filter(gap,country =="Germany"),aes(y=lifeExp,x=gdpPercap,group=country))+
geom_path()+
labs(y="lifespan",x="income")+
ggtitle("Germanys income and lifespan over time(1952-2007)")
d)Wie sich in folgender Grafik zeigt, ist Kuwait ein sehr interessantes Land in diesem Kontext. Wie wir sehen ist hier die Lebenserwartung mit sinkendem pro Kopf-Einkommen gestiegen. Einen Grund hierfür liefert der starke Bevölkerungszuwachs von 160.000 Menschen 1952 zu 2.505.559 Menschen 2007. Da die Haupteinnahmequelle Öl nicht durch bspw. mehr Arbeiter gesteigert werden kann, sinkt das pro-Kopf Einkommen mit steigender Bevölkerungszahl. Die anderen drei Länder weisen trotz unterschiedlicher Niveaus, den allgemeinen Trend des BBC-Videos auf. Kuwait könnte hier also als Ausnahme gesehen werden.
ggplot(filter(gap, country %in% c("Kuwait","Singapore","China","India")),aes(x=gdpPercap,y=lifeExp,group=country,color=country))+
scale_x_log10(breaks=c(400,4000,40000))+
geom_path(aes(size=year))+
labs(y="lifespan",x="income")+
ggtitle("China, India, Kuwait and Singapor over time (1952-2007)")
e)Durch die folgenden zwei Darstellungen werden Lebenserwartung und Einkommen isoliert über die Zeit betrachtet und als Boxplotsdargestellt. Durch diese Unterscheidung werden zwei Dinge deutlich, welche in der BBC-Darstellung nicht so deutlich erkennbar waren. Betrachtet man das erste Schaubild der Lebenserwartung, so wird deutlich, dass sich vor allem der dargestellte Median positiv entwickelt, während die unteren und oberen Extrema der Boxplots einen schwächeren positiven Trend aufweisen. Die Darstellung des Einkommens hingegen verrät, dass die Schere zwischen armen und reichen Ländern wesentlich größer geworden ist. Vor allem die nicht-logarithmierte Darstellung verrät dies. Vorteil dieser Darstellung ist demnach die isolierte Betrachtungsmöglichkeit und die Verdeutlichung des Medians über die Zeit. Zudem ist durch die Verwendung von Boxplots die Gewichtung der einzelnen Länder im weltweiten Kontext (zumindest was Lebenserwartung und Einkommen betrifft) nun klar ersichtlich. Nachteilig ist, dass 2 Graphen benötigt werden und die einzelnen Länder nicht dargestellt werden.
ggplot(gap, aes(year, lifeExp))+
geom_boxplot(aes(group = year))+
labs(y="lifespan")+
ggtitle("Lifespan of 142 countries over time in absolute values")
ggplot(gap, aes(year, gdpPercap))+
geom_boxplot(aes(group = year))+
labs(y="income")+
ggtitle("Income of 142 countries over time in absolute values")
eco <- read.table("data/WPP2015_DB02_Populations_Annual.csv", header=TRUE, sep=",")
eco2 <- eco %>%
filter(Location %in% c("Latin America and the Caribbean","Africa",
"Oceania", "Northern America", "Europe", "Asia"))%>%
filter(Variant=="Medium") %>%
filter(Time %in% c(2015,2050)) %>%
arrange(Location) %>%
group_by(Location) %>%
mutate(PopChange = round(((PopTotal-lag(PopTotal))/lag(PopTotal))*100,1))%>%
filter(!is.na(PopChange))%>%
select(Location,PopChange)
eco2$Location <- factor(eco2$Location, levels = eco2$Location[
order(
eco2$PopChange, decreasing =FALSE)
])
ggplot(eco2, aes(x=Location, y=PopChange))+
geom_bar(stat="identity", position="dodge", aes(fill=Location), width=.6) + coord_flip()+
ggtitle("Regional % change, 2015-50 forecast") + #Titel
geom_text(aes(label=PopChange), position=position_dodge(width=0.5), vjust=+0.25, hjust=-1)+
theme_minimal()+
geom_hline(yintercept = 0)+
scale_x_discrete(labels=c("Europe", "Asia", "North America","Latin America\n & the Caribbean", "Oceania", "Africa"))+
scale_fill_manual(values = c("#1DAFED","#E8CE8C", "#B186B4", "#71BCBF", "#7A2818", "#F4856A"))+
scale_y_continuous(limits=c(-5, 150), expand = c(0,0))+
theme(
plot.title=element_text(size = 12, face="bold", hjust = -.1),
axis.text.x=element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position="none",
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank()
)
eco3 <- eco %>%
filter(Location %in% c("Latin America and the Caribbean","Africa",
"Oceania", "Northern America", "Europe", "Asia"))%>%
filter(Variant=="Medium") %>%
filter(Time %in% c(2015,2050, 2099)) %>%
select(Location,Time, PopTotal)%>%
arrange(desc(Time), desc(PopTotal))
sumeco3 <- eco3 %>% #Summieren der Population pro Jahr
group_by(Time)%>%
summarise(Pop=round(sum(PopTotal)/1000000,1))
eco3$Time <- factor(eco3$Time, levels=eco3$Time)
ggplot(eco3, aes(x=Time, y=PopTotal, fill= Location))+
geom_bar(stat="identity", width = .6) + coord_flip() +
scale_fill_manual(values = c("Europe"="#1DAFED","Asia"="#E8CE8C", "Northern America"="#B186B4",
"Latin America and the Caribbean"="#71BCBF", "Oceania"="#7A2818",
"Africa"="#F4856A"),
breaks = c("Europe","Asia","Northern America",
"Latin America and the Caribbean", "Oceania","Africa"), #Reihenfolge definieren
labels = c("Europe", "Asia", "North America","Latin America\n & the Caribbean",
"Oceania", "Africa") #Namen ändern
)+
scale_y_continuous(limits = c(0,12.5*1000000), expand = c(0,0))+
scale_x_discrete(labels=c("2100 forecast","2050 forecast","2015"))+
ggtitle("Total population, bn") + #Titel
geom_text(aes(label=c(rep("",5), sumeco3$Pop[sumeco3$Time=="2099"],
rep("",5), sumeco3$Pop[sumeco3$Time=="2050"],
rep("",5), sumeco3$Pop[sumeco3$Time=="2015"])),
position="stack", hjust=-1)+
theme_minimal()+
theme(
plot.title=element_text(size = 14, face="bold", hjust = 0),
axis.text.y=element_text(face="bold", size=12),
axis.text.x=element_blank(),
legend.title =element_blank(),
legend.text =element_text(size=12),
axis.ticks = element_blank(),
legend.position="bottom",
axis.title = element_blank(),
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank()
)
Für jedes Jahr wurde ein eigenes Schaubild ausgegeben
#Schaubild für 1950
eco4<-eco %>%
filter(Time %in% c(1950,2015,2050),Variant=="Medium", Location %in% c("China","India","United States of America","Russian Federation","Japan","Germany","Indonesia","Brazil","United Kingdom","Italy","France","Bangladesh","Pakistan","Nigeria","Mexico","Philippines","Congo","Ethiopia","Egypt"))%>%
arrange(desc(PopTotal),Time)
eco4$Location <- factor(eco4$Location, levels = eco4$Location[order(eco4$PopTotal, decreasing = FALSE)])
ggplot(head(filter(eco4, Time==1950),12),aes(x=Location, y=PopTotal,group=Time))+
geom_bar(stat = "identity")+
coord_flip()+
labs(x = "") + labs(y = "")
#Schaubild für 2015
eco4<-eco %>%
filter(Time %in% c(2015,2050),Variant=="Medium", Location %in% c("China","India","United States of America","Russian Federation","Japan","Germany","Indonesia","Brazil","United Kingdom","Italy","France","Bangladesh","Pakistan","Nigeria","Mexico","Philippines","Congo","Ethiopia","Egypt"))%>%
arrange(desc(PopTotal),Time)
eco4$Location <- factor(eco4$Location, levels = eco4$Location[order(eco4$PopTotal, decreasing = FALSE)])
ggplot(head(filter(eco4, Time==2015),12),aes(x=Location, y=PopTotal,group=Time))+
geom_bar(stat = "identity")+
coord_flip()+
labs(x = "") + labs(y = "")
#Schaubild für 2050 forecast
eco4<-eco %>%
filter(Time==2050 ,Variant=="Medium", Location %in% c("China","India","United States of America","Russian Federation","Japan","Germany","Indonesia","Brazil","United Kingdom","Italy","France","Bangladesh","Pakistan","Nigeria","Mexico","Philippines","Democratic Republic of the Congo","Ethiopia","Egypt"))%>%
arrange(desc(PopTotal),Time)
eco4$Location <- factor(eco4$Location, levels = eco4$Location[order(eco4$PopTotal, decreasing = FALSE)])
ggplot(head(filter(eco4, Time==2050),12),aes(x=Location, y=PopTotal,group=Time))+
geom_bar(stat = "identity")+
coord_flip()+
labs(x = "") + labs(y = "")
Die unterschiedlichen Farben grenzen die Kontinente voneinander ab. Die Länder werden somit ihren Kontinenten zugewiesen. Als Resultat können nicht nur die Länder, sondern auch die Kontinente betrachtet werden. Mittels der Pfeile zwischen den einzelnen Schaubildern können Veränderungen schnell erkannt werden.
Deutlich zu erkennen ist in diesen Schaubildern, dass Europa enorm an Population verliert und die Bevölkerung in Afrika stark zunimmt. Auch Asien wächst weiterhin und besitzt mit China und Indien (auch 2050) die bevölkerungsreichsten Länder. Laut Prognose wird Indien 2050 Platz 1 belegen. Außerdem ist hervorzuheben, dass die Bevökerung Nigerias rapide gewachsen ist und sogar im Jahr 2050 auf Platz 3 (hinter Indien & China) progostiziert wird. Weitere Länder des afrikanischen Kontients (Kongo, Äthiopien, Ägypten) werden 2050 unter den bevökerungsreichsten Ländern vertreten sein.